Winzipper/Winzipper_ISO.iso/programming/oracle7 7.2/DB/UTIL72/PRVTLOCK.SQL

Text File | 1995-05-09 | 9.6 KB | 319 lines

rem
rem $Header: prvtlock.sql 7020200.1 95/02/15 18:27:17 cli Generic<base> $
rem
Rem
Rem    NAME
Rem      prvtlock.sql - locking routines provided by Oracle
Rem    DESCRIPTION
Rem      These are private functions to be released in PL/SQL binary form.
Rem      See below
Rem    RETURNS
Rem
Rem    NOTES
Rem     The procedural option is needed to use this facility.
Rem
Rem     Lockids from 2000000000 to 2147483647 are reserved for products
Rem     supplied by Oracle:
Rem
Rem       Package                     Lock id range
Rem       =================================================
Rem       dbms_alert                  2000000000-2000002041
Rem       dbms_alert                  2000002042-2000003063
Rem
Rem    MODIFIED   (MM/DD/YY)
Rem     pgreenwa   11/14/94 -  merge changes from branch 1.1.710.3
Rem     pgreenwa   11/10/94 -  bug #248150: fix timeouts on dbms_lock_allocated
Rem     wmaimone   04/08/94 -  merge changes from branch 1.1.710.2
Rem     adowning   03/29/94 -  merge changes from branch 1.1.710.1
Rem     wmaimone   02/22/94 -  use create or replace
Rem     adowning   02/04/94 -  Branch_for_patch
Rem     adowning   02/04/94 -  Creation
Rem     adowning   02/02/94 -  split file into public / private binary files
Rem     rkooi      12/03/92 -  change comments
Rem     rkooi      11/25/92 -  return 5 instead of 6 per spec
Rem     rkooi      11/24/92 -  check for nulls
Rem     rkooi      11/18/92 -  add comments
Rem     rkooi      08/20/92 -  comments and cleanup
Rem     rkooi      06/29/92 -  add some comments
Rem     rkooi      05/30/92 -  fix timeout problems
Rem     rkooi      04/30/92 -  add some comments
Rem     rkooi      04/25/92 -  misc change
Rem     rkooi      04/12/92 -  Creation

Rem This script must be run as user SYS

REM ************************************************************
REM THIS PACKAGE MUST NOT BE MODIFIED BY THE CUSTOMER.  DOING SO
REM COULD CAUSE INTERNAL ERRORS AND CORRUPTIONS IN THE RDBMS.
REM FOR INSTANCE, THE PSD* ROUTINES MUST NOT BE CALLED DIRECTLY
REM BY ANY CLIENT AND MUST REMAIN PRIVATE TO THIS PACKAGE.
REM ************************************************************

drop table dbms_lock_allocated
/
create table dbms_lock_allocated(
    name        varchar2(128) primary key,
    lockid        integer,
    expiration    date)
/
drop sequence dbms_lock_id
/

create sequence dbms_lock_id start with 1073741824 maxvalue 1999999999
/

create or replace package body dbms_lock is

  procedure psdlgt(id binary_integer, lockmode binary_integer,
                   maxholders binary_integer, timeout binary_integer,
                   release_on_commit binary_integer,
                   global_lock binary_integer, status in out binary_integer);
    pragma interface (C, psdlgt);
  procedure psdlcv(id binary_integer, lockmode binary_integer,
             maxholders binary_integer, timeout binary_integer,
           status in out binary_integer);
    pragma interface (C, psdlcv);
  procedure psdlrl(id binary_integer, status in out binary_integer);
    pragma interface (C, psdlrl);
  procedure psdwat(tens_of_millisecs binary_integer);
    pragma interface (C, psdwat);

  procedure convertback(lockhandle varchar2,
                        id out integer,
                        status out integer) is
    tmpid integer;
  begin
    begin
      status := 0;
      id := -1;
      if length(lockhandle)=0 then
        status := 5;
      else
        tmpid := to_number(substr(lockhandle,1,10));
        if (tmpid <> to_number(substr(lockhandle,11,10))) then
          status := 5;
        elsif (tmpid mod 239) <> to_number(substr(lockhandle,21,10)) then
          status := 5;
        elsif tmpid<1073741824 or tmpid>1999999999 then
          status := 3;
        else
          id := tmpid;
        end if;
      end if;
    exception when others then
      status := 5;
    end;
  end;

  function  internal_request(id integer,
                    lockmode integer,
                    timeout integer,
                    release_on_commit boolean,
                    global_lock boolean)
            return integer is
  arg1    binary_integer;
  arg2    binary_integer;
  arg3    binary_integer;
  arg4    binary_integer;
  arg5    binary_integer;
  arg6    binary_integer;
  status  binary_integer;
  begin
    if timeout<0 or lockmode<1 or lockmode>6 then
      return 3;
    end if;
    if id is null or lockmode is null or timeout is null then
      return 3;
    end if;
    arg1 := id;
    arg2 := lockmode;
    arg3 := 0;
    if timeout>maxwait then
      arg4 := maxwait;
    else
      arg4 := timeout;
    end if;
    if release_on_commit then
      arg5 := 1;
    else
      arg5 := 0;
    end if;
    if global_lock then
      arg6 := 1;
    else
      arg6 := 0;
    end if;
    psdlgt(arg1, arg2, arg3, arg4, arg5, arg6, status);
    return status;
  end;

  function  request(lockhandle varchar2,
                    lockmode integer default x_mode,
                    timeout integer default maxwait,
                    release_on_commit boolean default FALSE)
            return integer is
    id integer;
    status integer;
  begin
    convertback(lockhandle, id, status);
    if status <> 0 then
      return status;
    end if;
    return internal_request(id, lockmode, timeout, release_on_commit, TRUE);
  end;

  function  request(id integer,
                    lockmode integer default x_mode,
                    timeout integer default maxwait,
                    release_on_commit boolean default FALSE)
            return integer is
  begin
    if id<0 or (id>1073741823 and id<2000000000) then
      return 3;
    end if;
    return internal_request(id, lockmode, timeout, release_on_commit, TRUE);
  end;

  function internal_convert(id integer,
                   lockmode integer,
                   timeout number)
           return integer is
    arg1   binary_integer;
    arg2   binary_integer;
    arg3   binary_integer;
    arg4   binary_integer;
    status binary_integer;
  begin
    if timeout<0 or lockmode<1 or lockmode>6 then
      return 3;
    end if;
    if id is null or lockmode is null or timeout is null then
      return 3;
    end if;
    arg1 := id;
    arg2 := lockmode;
    arg3 := 0;
    if timeout>maxwait then
      arg4 := maxwait;
    else
      arg4 := timeout;
    end if;
    psdlcv(arg1, arg2, arg3, arg4, status);
    return status;
  end;

  function convert(lockhandle varchar2,
                   lockmode integer,
                   timeout number default maxwait)
           return integer is
    id integer;
    status integer;
  begin
    convertback(lockhandle, id, status);
    if status <> 0 then
      return status;
    end if;
    return internal_convert(id, lockmode, timeout);
  end;

  function convert(id integer,
                   lockmode integer,
                   timeout number default maxwait)
           return integer is
  begin
    if id<0 or (id>1073741823 and id<2000000000) then
      return 3;
    end if;
    return internal_convert(id, lockmode, timeout);
  end;

  function internal_release(id integer) return integer is
    arg1   binary_integer;
    status binary_integer;
  begin
    if id is null then
      return 3;
    end if;
    arg1 := id;
    psdlrl(arg1, status);
    return status;
  end;

  function release(lockhandle varchar2) return integer is
    id integer;
    status integer;
  begin
    convertback(lockhandle, id, status);
    if status <> 0 then
      return status;
    end if;
    return internal_release(id);
  end;

  function release(id integer) return integer is
  begin
    if id<0 or (id>1073741823 and id<2000000000) then
      return 3;
    end if;
    return internal_release(id);
  end;

  procedure sleep(seconds number) is
    arg1   binary_integer;
  begin
    arg1 := seconds*100;
    psdwat(arg1);
  end;

  procedure allocate_unique(lockname in varchar2,
                lockhandle out varchar2,
                expiration_secs in integer default 864000) is
    lockid integer;
    cursor c1(lname varchar2) is
      select lockid from dbms_lock_allocated where name = c1.lname for update;
    trycount integer := 0;
  begin
    <<retryloop>>
    loop
      open c1(lockname);
      fetch c1 into lockid;
      if c1%notfound then
        close c1;
        if trycount >= 1 then
          raise_application_error(-20000,
           'ORU-10003: Unable to find or insert lock '''
            || lockname || ''' into catalog dbms_lock_allocated.');
        end if;
        begin
          -- we are first to try to allocate this lock.  So allocate
          -- a lockid.
          select dbms_lock_id.nextval into lockid from dual;
          -- do periodic cleanout.
          if (lockid mod 100) = 0 then
            delete dbms_lock_allocated where expiration < sysdate;
            commit;
          end if;
          insert into dbms_lock_allocated values (lockname, lockid,
            sysdate + (expiration_secs/86400));
          exit retryloop;
        exception when dup_val_on_index then
          -- someone must have inserted this key into the table between the
          -- the time we did the select and the time we tried to insert.
          -- So retry.
          trycount := trycount+1;
        end;
      else
        update dbms_lock_allocated
          set expiration = sysdate + (expiration_secs/86400)
          where current of c1;
        close c1;
        exit retryloop;
      end if;
    end loop;
    lockhandle := to_char(lockid)||to_char(lockid)||to_char(lockid mod 239);
    commit;
  end;

end;
/